I plotted the distribution of track and field Olympic medals awarded through 2016 from the top five medal producing countries (Great Britain, Germany, Kenya, Russia, and the United States). I looked at both gold medals exclusively and overall medals, and also considered cumulative awards versus medals awarded in each Olympic Games. The goal of these plots is to show how the trends for different countries changed in the last century plus; for example, Kenya and Russia did not win any medals for many decades, then became rather prolific, whereas Germany hit its peak in the ’60s, ’70s and ’80s (the German phenomenon is due to a combination of East Germany and West Germany each sending a team and likely state sponsored doping from the East German government).

I utilized subplots in Plotly with common X axes so it was more clear what the trends were. This also allowed 2 range sliders to be utilized so the viewer can zoom in to a era of interest in both the cumulative and “per Games” graphs simultaneously. I let values show on each line when hovered over, but opted to limit it only to one line at a time (as opposed to all five) so as not to overwhelm the viewer. However, it can be selected in the top right corner that each country should be compared together, which helps visualize the differences. No legend was provided, as it would have been redundant given the hover labels that were included (the legend also showed up four times when it was included - once for each graph - and I was unable to eliminate the duplicates).

The data came from Kaggle. Below is all the data cleaning to prepare for a plotly plot.

# Load libraries that may be needed
library(ggplot2)
library(htmlwidgets)
library(plotly)
library(tidyr)
library(dplyr)
library(readr)
library(viridis)
library(ggthemes)
#font size etc to use for subplot titles
f <- list(
  family = "Courier New, monospace",
  size = 18,
  color = "black")

#all medal plots
ply_cumul <- plot_ly(medals7, 
        x = ~years,
        y = ~cumul,
        color = nats,
        type = 'scatter',
        mode = 'lines',
        width = 900, height = 700
        ) %>%
  layout(yaxis = list(title = "Cumulative Medals"))

ply_count <- plot_ly(medals7,
          x = ~years,
          y = ~count,
          color = nats,
          type = 'scatter',
          mode = 'lines',
          width = 900, height = 700
          ) %>%
  layout(yaxis = list(title = "Medals per Games"))

a <- list(
  text = "All Medals",
  font = f,
  xref = "paper",
  yref = "paper",
  yanchor = "bottom",
  xanchor = "center",
  align = "center",
  x = 0.5,
  y = 1,
  showarrow = FALSE)

ply_stack <- subplot(list(ply_cumul, ply_count),
                     nrows = 2,
                     shareX = TRUE,
                     titleY = TRUE) %>%
    layout(annotations = a,
           showlegend = FALSE) %>%
    rangeslider()

#Gold medal plots
ply_cumul_g <- plot_ly(medals7, 
        x = ~years,
        y = ~g_cumul,
        color = nats,
        type = 'scatter',
        mode = 'lines',
        width = 900, height = 700
        )

ply_count_g <- plot_ly(medals7,
          x = ~years,
          y = ~g_count,
          color = nats,
          type = 'scatter',
          mode = 'lines',
          width = 900, height = 700
          )
b <- list(
  text = "Gold Medals",
  font = f,
  xref = "paper",
  yref = "paper",
  yanchor = "bottom",
  xanchor = "center",
  align = "center",
  x = 0.5,
  y = 1,
  showarrow = FALSE)

ply_stack_g <- subplot(list(ply_cumul_g, ply_count_g),
                     nrows = 2,
                     shareX = TRUE,
                     titleY = FALSE)%>%
    layout(annotations = b,
           showlegend = FALSE) %>%
    rangeslider()

#combining both vertical stacks
all_ply_stack <- subplot(list(ply_stack, ply_stack_g),
                         titleY = TRUE) %>%
         layout(showlegend = FALSE)

all_ply_stack